home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0103_ROM Font in $13.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  3KB  |  63 lines
  1. {
  2.  The following does not use assembly but it should do what you want,
  3.  and should give you an idea about how its done incase you want to
  4.  translate it to BASM later. It uses the ROM text font information
  5.  for its screen writes.
  6.  
  7. {***********************************************************************}
  8. PROGRAM RomFontDemo;            { May 08/94, Greg Estabrooks.           }
  9. VAR
  10.    Colors :BYTE;
  11.  
  12. PROCEDURE SetVidMode( Mode :BYTE ); ASSEMBLER;
  13.                 {  Routine to set video mode                            }
  14. ASM
  15.   Mov AH,00                     {  Function to set mode                 }
  16.   Mov AL,Mode                   {  Mode to change to                    }
  17.   Int $10                       {  Call dos                             }
  18. END;{SetVidMode}
  19.  
  20. PROCEDURE PutPixel( X,Y :WORD; Color :BYTE );
  21. BEGIN
  22.   Mem[$A000:(320*Y)+X]:= Color;
  23. END;
  24.  
  25. PROCEDURE WriteXY( X,Y :WORD; Color :BYTE; Str :STRING );
  26. VAR
  27.    OldX :WORD;                  { Holds Original Column.                }
  28.    OldY :WORD;
  29.    StrPos :BYTE;                { Character pos in string to write.     }
  30.    FontChr:BYTE;                { ROM font info.                        }
  31.    FontPos:BYTE;
  32.    BitPos :BYTE;
  33. BEGIN
  34.   OldY := Y;                    { Save Starting Row.                    }
  35.   FOR StrPos := 1 TO Length(Str) DO
  36.   BEGIN                         { Loop through every character.         }
  37.    OldX := X;                   { Save Current Column.                  }
  38.    Y := OldY;                   { Restore starting row.                 }
  39.    FOR FontPos := 0 TO 7 DO
  40.    BEGIN                        { Scroll through all 8 BYTES of font.   }
  41.     FontChr := MEM[$FFA6:$E+(ORD(Str[StrPos]) SHL 3) + FontPos];
  42.     FOR BitPos := 7 DOWNTO 0 DO
  43.     BEGIN                       { Scroll through all 8 BITS of each BYTE.}
  44.      IF (FontChr AND (1 SHL BitPos)) <> 0 THEN
  45.       PutPixel(X,Y,Color);      { IF bit is set then draw pixel.        }
  46.      INC(X);                    { point to next column.                 }
  47.     END;
  48.     INC(Y);                     { point to next row.                    }
  49.     X := OldX;                  { Restore old column for next line.     }
  50.    END;
  51.    X := X + 8;                  { Move 9 columns ahead.                 }
  52.   END;
  53. END;{WriteXY}
  54.  
  55. BEGIN
  56.   SetVidMode($13);
  57.   FOR Colors := 1 TO 19 DO
  58.    WriteXY(Colors*10,Colors*10,Colors,'Greg Estabrooks');
  59.   Readln;
  60.   SetVidMode($03);
  61. END.
  62. {***********************************************************************}
  63.